home *** CD-ROM | disk | FTP | other *** search
- -> ShellScr v1.4 by Kyzer/CSG
- -> Creates a fullscreen shell with it's own public screen
-
- OPT PREPROCESS,OSVERSION=37
-
- MODULE 'asl', 'diskfont', 'dos/dos', 'dos/dostags', 'exec/nodes',
- 'graphics/text', 'intuition/screens', 'libraries/asl',
- 'utility/tagitem', 'workbench/startup',
- '*args', '*clr', '*defarg', '*paths'
-
- RAISE "MEM" IF String()=NIL
-
- #define TEMPLATE \
- 'PUBNAME=NAME,MODEID=ID,DEPTH/N,FONT/K,'+\
- 'SCREENTITLE=TITLE,NOTITLE=HIDETITLE/S,'+\
- 'CONSPEC=WINDOW,COMMANDFILE=FROM'
-
- OBJECT myargs
- pubname -> chosen public screen name or NIL
- modeid -> string referencing mode-id or NIL
- depth -> ptr to LONG number or NIL: depth of screen
- font -> ptr to font description ('fontname/size') or NIL
-
- title -> string: name of titlebar or NIL
- notitle -> boolean, non-zero = hide titlebar, zero = show titlebar
-
- conspec -> WINDOW parameter of NewShell
- cmdfile -> FROM parameter of NewShell
- ENDOBJECT
-
- DEF args:myargs, rdargs=NIL, sig, pubname[16]:STRING
-
- PROC main() HANDLE
- DEF wbmsg:PTR TO wbstartup, dir, newdir=NIL, screen=NIL
-
- -> allocate a signal bit
- IF (sig := AllocSignal(-1))=-1 THEN RETURN
-
- -> generate default name for a public screen
- StringF(pubname, 'SHELL_\z\h[8]', FindTask(NIL))
-
- -> read arguments with fabulous wb-friendly readargs()
- clr(args, SIZEOF myargs)
- IF (rdargs:=readargs(TEMPLATE, args, wbmessage))=NIL THEN Raise("args")
-
- -> choose reasonable start directory from WB
- IF wbmsg := wbmessage
- IF wbmsg.numargs > 1 THEN newdir := DupLock(wbmsg.arglist[1].lock)
- IF newdir=NIL THEN newdir := DupLock(GetProgramDir())
- IF newdir THEN dir := CurrentDir(newdir)
- ENDIF
-
- -> open the screen, construct the command, run it
- SystemTagList(
- makecmd(screen := openscr()),
- NEW [NP_PATH, getpath(), TAG_DONE]
- )
-
- -> wait for "last-window-gone" signal (or CTRL-C, for no good reason :)
- Wait(Shl(1,sig) OR SIGBREAKF_CTRL_C)
-
- WHILE CloseScreen(screen)=0 DO EasyRequestArgs(NIL, [20, 0, 'ShellScr',
- 'This screen is closing. Please close all visitor windows.', 'OK'], 0, 0
- )
-
- EXCEPT DO
- SELECT exception
- CASE "MEM"; SetIoErr(ERROR_NO_FREE_STORE); msg(error())
- CASE "LIB"; SetIoErr(ERROR_INVALID_RESIDENT_LIBRARY); msg(error())
- CASE "args"; msg(error('Bad args'))
- CASE "dfsc"; msg('Cannot get a default screen')
- CASE "scr"; msg('Cannot open screen: \s', NEW [screenerror(exceptioninfo)])
- ENDSELECT
-
- IF newdir THEN CurrentDir(dir)
- IF newdir THEN UnLock(newdir)
- IF rdargs THEN FreeArgs(rdargs)
- FreeSignal(sig)
- ENDPROC
-
-
- ->-----------------------------------------------------------------------------
-
-
- PROC makecmd(s:PTR TO screen)
- -> create the 'NewShell' command required
- DEF cmd, cmdformat, sizes, top, scrname
-
- -> generate command formatter : 'NewShell [conspec] [FROM cmdfile]'
- -> conspec contains two '%s' ('\s') formatters for windowsize and screenname
- StringF(
- cmdformat:=String(
- 9 +
- (IF args.conspec THEN StrLen(args.conspec) ELSE 64) +
- (IF args.cmdfile THEN StrLen(args.cmdfile)+6 ELSE 0)
- ),
- 'NewShell \s\s\s',
- defarg(args.conspec,
- 'CON:\s//BACKDROP/NOBORDER/NOSIZE/NODRAG/NODEPTH/NOCLOSE/SCREEN\s'
- ),
- IF args.cmdfile THEN ' FROM ' ELSE '',
- defarg(args.cmdfile, '')
- )
-
- -> window-size calculation (see guide)
- top:=IF args.notitle THEN 0 ELSE IF args.conspec THEN s.barheight+1 ELSE 3
- StringF(sizes:=String(23), '\d/\d/\d/\d', 0, top, s.width, s.height-top)
-
- -> name of public screen
- scrname := defarg(args.pubname, pubname)
-
- -> create final command from format template
- StringF(
- cmd:=String(EstrLen(cmdformat) + EstrLen(sizes) + StrLen(scrname)),
- cmdformat, sizes, scrname
- )
- ENDPROC cmd
-
-
- ->-----------------------------------------------------------------------------
-
-
- PROC openscr() HANDLE
- -> opens the screen as requested by the user
-
- DEF ds=NIL:PTR TO screen, dri=NIL:PTR TO drawinfo, s=NIL:PTR TO screen,
- fontdesc=NIL:PTR TO textattr, font=NIL:PTR TO textfont, name, size,
- errorcode
-
- ->--- font support
- -> find out the real name/size of our requested (or not) font
- -> assume we must load first instance of font from disk first
- -> tsssk the user if he picked a proportional font
-
- name, size := getfont(args.font)
-
- IF name THEN
- IF diskfontbase := OpenLibrary('diskfont.library', 37) THEN
- IF font := OpenDiskFont(fontdesc:=NEW [name, size, 0, 0]:textattr) THEN
- IF font.flags AND FPF_PROPORTIONAL THEN
- msg('Requested font "\s/\d" is not fixed-width!', NEW [name, size])
-
- -> Find a default screen to read information about
- IF (ds := LockPubScreen(NIL))=NIL THEN Raise("dfsc")
-
- dri := GetScreenDrawInfo(ds)
-
- s := OpenScreenTagList(NIL, NEW [
- SA_PUBNAME, defarg(args.pubname, pubname),
- SA_PUBSIG, sig,
- SA_PUBTASK, FindTask(NIL),
- SA_TYPE, PUBLICSCREEN,
- SA_DISPLAYID, defarg(getmode(args.modeid), GetVPModeID(ds.viewport)),
-
- SA_TITLE, defarg(args.title, 'AmigaShell'),
- SA_SHOWTITLE, IF args.notitle THEN FALSE ELSE TRUE,
- SA_FONT, defarg(fontdesc, IF ds.font.flags AND
- FPF_PROPORTIONAL THEN NIL ELSE ds.font),
-
- SA_DEPTH, IF args.depth THEN Long(args.depth) ELSE 2,
- SA_FULLPALETTE, TRUE,
- SA_PENS, IF dri THEN dri.pens ELSE [-1]:INT,
-
- SA_ERRORCODE, {errorcode},
- TAG_DONE
- ])
-
- IF s=NIL THEN Throw("scr", errorcode)
-
- PubScreenStatus(s, PUBLICSCREEN) -> make screen go public
-
- EXCEPT DO
- CloseLibrary(diskfontbase)
- CloseLibrary(aslbase)
-
- IF dri THEN FreeScreenDrawInfo(ds, dri)
- IF ds THEN UnlockPubScreen(NIL, ds)
-
- IF font THEN CloseFont(font)
- ReThrow()
- ENDPROC s
-
-
- ->-----------------------------------------------------------------------------
-
-
- PROC getmode(modename)
- -> process string with hex/decimal/'?'/'' modeid and return numeric ID
- DEF modeid, req:PTR TO screenmoderequester, ok
-
- IF modename=NIL THEN RETURN 0
-
- -> ASL screenmode requester when modename='?' or ''
- IF (StrCmp(modename, '?') OR StrCmp(modename, '')) AND asl()
- IF req := AllocAslRequest(ASL_SCREENMODEREQUEST, NIL)
- IF ok := AslRequest(req, NIL) THEN
- msg('Chosen MODEID = 0x\h', NEW [modeid := req.displayid])
- FreeAslRequest(req)
- ENDIF
- RETURN IF ok THEN modeid ELSE 0
- ENDIF
-
- -> otherwise - a numeric ID.
-
- -> change '0xB1AB1A' into '$B1AB1A'
- IF StrCmp(modename, '0x', 2); INC modename; modename[]:="$"; ENDIF
- ENDPROC Val(modename)
-
- ->----
-
- PROC getfont(fontname) HANDLE
- -> process font-string (eg 'topaz/11', 'flyspeck', '?') and return
- -> proper name and size ('topaz.font',11 , 'flyspeck.font',8 , ...)
- -> requires slightly different coding to the modeid processor...
- DEF font=NIL, size=8, req=NIL:PTR TO fontrequester, ok, n
-
- IF fontname=NIL THEN Raise()
-
- -> ASL font requester on fontname='?' or fontname=''
- IF (StrCmp(fontname, '?') OR StrCmp(fontname, '')) AND asl()
- IF req := AllocAslRequest(ASL_FONTREQUEST, NIL)
- IF AslRequest(req, [ASLFO_FIXEDWIDTHONLY, TRUE, TAG_DONE])
- fontname := req.attr.name; size := req.attr.ysize
- ENDIF
- ENDIF
- ENDIF
-
- -> copy fontname so we can (perhaps) modify it
- StrCopy(font:=String(StrLen(fontname)+5), fontname)
-
- -> look for and remove size (in 'myfont/99' format) from string
- IF (n := InStr(font, '/'))<>-1
- -> get size from string (or 8 as default)
- size, ok := Val(font+n+1)
- IF ok=0 THEN size := 8
-
- -> remove size part from string
- font[n] := "\0" -> can we guarantee SetStr() to do this?
- SetStr(font, StrLen(font))
- ENDIF
-
- -> add '.font' to name if neccessary
- IF InStr(font, '.font')=-1 THEN StrAdd(font, '.font')
-
- EXCEPT DO
- IF req THEN FreeAslRequest(req)
- ENDPROC font, size
-
- ->-----------------------------------------------------------------------------
- -> handy little things...
-
- PROC screenerror(err)
- -> sensible names for OpenScreen() errors
- DEF errors:PTR TO LONG
- errors:=[
- 'No error',
- 'Chosen ModeID is not available',
- 'Better chipset required to display this mode',
- 'Not enough memory',
- 'Not enough chip memory',
- 'Public name already in use',
- 'Unknown ModeID',
- 'Too many bitplanes'
- ]
- ENDPROC IF (err<0) OR (err>7) THEN 'Unknown error' ELSE errors[err]
-
- PROC msg(msg, args=NIL)
- -> message-printer for WB and shell
- IF wbmessage
- EasyRequestArgs(NIL, [20, 0, 'ShellScr', msg, 'OK'], 0, args)
- ELSE
- VfPrintf(stdout, msg, args)
- PutStr('\n')
- ENDIF
- ENDPROC
-
- PROC error(header=NIL)
- -> returns string form of DOS Fault. Can prepend header.
- DEF x
- SetStr(x:=String(StrLen(header) + FAULT_MAX + 2),
- Fault(IoErr(), header, x, StrMax(x))
- )
- ENDPROC x
-
- PROC asl()
- -> open asl.library only once
- IF aslbase THEN RETURN
- aslbase := OpenLibrary('asl.library', 38)
- ENDPROC
-
- -> $VER: ShellScr.e 1.4 (10.04.98)
- CHAR '$VER: ShellScr 1.4 (10.04.98)',0
-